Developer CD Series 1996 February: Tool Chest/Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso/Tool Chest/Development Tools & Languages/HyperCard Related/APDA HyperCard Toolkits/HyperCard Video Toolkit 2.0/HVT #2/Advanced Material/Video Sources/setVideoPlayer.p

Text File | 1995-02-07 | 4.9 KB | 190 lines | [TEXT/MPS ]

(*
    setTypeOfVideo playerName - Select the type of videodisc player being used. The parameter
        playerName is the name of the player. The player name can be a short name or a long
        name. The driver for the player is the short name with "vidDrvr" prepended. For example,
        the Pioneer 4200 has a short name of "P4200", a long name of "Pioneer 4200", and a
        drivers named "vidDrvrP4200".

    To compile and link this file using Macintosh Programmer's Workshop,

        pascal -w setVideoPlayer.p

        link -m ENTRYPOINT -o HyperCommands -rt XCMD=8006 -sn Main=setVideoPlayer ∂
            setVideoPlayer.p.o "{MPW}"Libraries:interface.o "{MPW}"PLibraries:PasLib.o

    Copyright © 1987,88 Apple Computer, Inc.

    9/87 - Initial coding by Harry R. Chesley.
    2/88 - Changed for new interface specification by Harry R. Chesley.
*)

{$R-}

{$S setVideoPlayer }     { Segment name must be the same as the command name. }

unit DummyUnit;

interface

uses MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXCmd;

procedure EntryPoint(paramPtr: XCmdPtr);

implementation

type

Str31 = String[31];

procedure setVideoPlayer(paramPtr: XCmdPtr); forward;

procedure EntryPoint(paramPtr: XCmdPtr);

    begin
        setVideoPlayer(paramPtr);
    end;

procedure setVideoPlayer(paramPtr: XCmdPtr);

    var str: str255;
        nameToSet: str255;            { The requested name. }
        resHandle: Handle;            { Driver resource handle. }
        resID: integer;                    { Driver resource ID. }
        resType: ResType;            { Driver resource type. }
        resName: str255;                { Driver resource name. }
        i: integer;
        thePlayers: Handle;            { List of HyperTalk players (as opposed to XCMD players). }
        p, p2: Ptr;
        lastChar: SignedByte;

    {$I XCmdGlue.inc}

    procedure Fail(errMsg: Str255); { set theResult and quit }
        begin
            paramPtr^.returnValue := PasToZero(errMsg);
            exit(setVideoPlayer);
        end;

    {$I VideoUtil.inc}

    function nameInList(list: str255; name: str255): boolean;

        var itemStart: integer;
            itemEnd: integer;

        begin
            itemStart := 1;
            while itemStart <= length(list) do
                begin
                    if list[itemStart] = ',' then itemStart := itemStart+1
                    else
                        begin
                            itemEnd := itemStart+1;
                            while itemEnd <= length(list) do
                                if list[itemEnd] = ',' then leave
                                else itemEnd := itemEnd+1;
                            if StringEqual(Copy(list,itemStart,itemEnd-itemStart),name) then
                                begin
                                    nameInList := true;
                                    exit(nameInList);
                                end;
                            itemStart := itemEnd;
                        end;
                end;
            nameInList := false;
        end;

    procedure setName(var name: str255);
        { Set the player. }

        begin
            { Remember the name. }
            SetStrGlobal('typeOfVideo',name);
            { Use the default communications settings. }
            videoCmd('control','defaultComm');
        end;

    begin
        if paramPtr^.paramCount <> 1 then Fail('parameter count is not 1');

        { Get the name to set. }
        GetStrParm(1,nameToSet);

        { Check for the special case of None. }
        if StringEqual(nameToSet,'none') then
            begin
                SetStrGlobal('typeOfVideo','');
                exit(setVideoPlayer);
            end;

        { Get any HyperTalk drivers. }
        thePlayers := GetGlobal('videoHTPlayers');
        if thePlayers <> nil then
            begin
                { Cycle thru looking for a match. }
                HLock(thePlayers);
                p := Ptr(ord4(thePlayers^)-1);
                p2 := Ptr(ord4(p)+1);
                repeat
                    p := Ptr(ord4(p)+1);
                    lastChar := p^;
                    { End of item? }
                    if (lastChar = ord(',')) or (lastChar = 0) then
                        begin
                            { Anything there? }
                            if p <> p2 then
                                begin
                                    { If yes, then convert it to a Pascal item in place (more or less). }
                                    p^ := 0;
                                    ZeroToPas(p2,str);
                                    { Check for short name match. }
                                    if StringEqual(str,nameToSet) then
                                        begin
                                            setName(nameToSet);
                                            exit(setVideoPlayer);
                                        end;
                                    { Check for long name match. }
                                    if nameInList(EvalStr(Concat('vidDrvr',str,'(name)')),nameToSet) then
                                        begin
                                            setName(str);
                                            exit(setVideoPlayer);
                                        end;
                                        end;
                            p2 := Ptr(ord4(p)+1);
                        end;
                until lastChar = 0;
                DisposHandle(thePlayers);
            end;

        { Now try all the XFCN drivers. }
        for i := 1 to CountResources('XFCN') do
            begin
                { Get the resource info. }
                resHandle := GetIndResource('XFCN',i);
                GetResInfo(resHandle,resID,resType,resName);
                { If this is a driver... }
                if length(resName) > 7 then
                    if StringEqual(Copy(resName,1,7),'vidDrvr') then
                        begin
                            { Check the short name. }
                            resName := Copy(resName,8,length(resName)-7);
                            if StringEqual(resName,nameToSet) then
                                begin
                                    setName(nameToSet);
                                    exit(setVideoPlayer);
                                end;
                            { Check the long name. }
                            if nameInList(EvalStr(Concat('vidDrvr',resName,'(name)')),nameToSet) then
                                begin
                                    setName(resName);
                                    exit(setVideoPlayer);
                                end;
                        end;
            end;

        { If we can't find anything, set it anyway and hope he knows what he's doing. }
        setName(nameToSet);
    end;

end.